Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/an210x/bindery.frm

Text File | 1995-05-08 | 13KB | 377 lines

VERSION 2.00
Begin Form Form1
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Bindery Object Lister"
   ClientHeight    =   4725
   ClientLeft      =   135
   ClientTop       =   600
   ClientWidth     =   9510
   Height          =   5130
   Icon            =   BINDERY.FRX:0000
   Left            =   75
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   ScaleHeight     =   4725
   ScaleWidth      =   9510
   Top             =   255
   Width           =   9630
   Begin CommandButton CloseButton
      Caption         =   "Close"
      Height          =   375
      Left            =   7800
      TabIndex        =   0
      Top             =   4200
      Width           =   1335
   End
   Begin CommandButton AboutButton
      Caption         =   "About ..."
      Height          =   375
      Left            =   6000
      TabIndex        =   2
      Top             =   3960
      Width           =   1335
   End
   Begin CommandButton RescanButton
      Caption         =   "Rescan"
      Height          =   375
      Left            =   7800
      TabIndex        =   16
      Top             =   3720
      Width           =   1335
   End
   Begin ListBox ServerNameBox
      Height          =   810
      Left            =   1440
      TabIndex        =   15
      Top             =   3720
      Width           =   3855
   End
   Begin ListBox BinderyObjList
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "Courier"
      FontSize        =   9.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   2565
      Left            =   45
      Sorted          =   -1  'True
      TabIndex        =   1
      Top             =   945
      Width           =   9420
   End
   Begin Label Label10
      Caption         =   "File Server:"
      Height          =   255
      Left            =   360
      TabIndex        =   11
      Top             =   3720
      Width           =   1095
   End
   Begin Label Label1
      Caption         =   "Add Props"
      Height          =   255
      Left            =   8400
      TabIndex        =   9
      Top             =   600
      Width           =   975
   End
   Begin Label Label7
      Caption         =   "Scan"
      Height          =   255
      Left            =   7800
      TabIndex        =   8
      Top             =   600
      Width           =   495
   End
   Begin Label Label14
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Label14"
      Height          =   15
      Left            =   7800
      TabIndex        =   12
      Top             =   480
      Width           =   1455
   End
   Begin Label Label4
      Caption         =   "Object ID"
      Height          =   255
      Left            =   5280
      TabIndex        =   5
      Top             =   480
      Width           =   855
   End
   Begin Label Label3
      Caption         =   "Object Type"
      Height          =   255
      Left            =   3120
      TabIndex        =   4
      Top             =   480
      Width           =   1095
   End
   Begin Label Label2
      Caption         =   "Object Name"
      Height          =   255
      Left            =   120
      TabIndex        =   3
      Top             =   480
      Width           =   1215
   End
   Begin Label Label6
      Alignment       =   2  'Center
      Caption         =   "Dyn/ Stat"
      Height          =   375
      Left            =   7035
      TabIndex        =   7
      Top             =   360
      Width           =   615
   End
   Begin Label Label5
      Alignment       =   2  'Center
      Caption         =   "Has Props"
      Height          =   375
      Left            =   6360
      TabIndex        =   6
      Top             =   360
      Width           =   615
   End
   Begin Label Label8
      Caption         =   "Access Control"
      Height          =   255
      Left            =   7875
      TabIndex        =   10
      Top             =   225
      Width           =   1335
   End
   Begin Label Label9
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Label9"
      Height          =   855
      Left            =   9450
      TabIndex        =   13
      Top             =   90
      Width           =   15
   End
   Begin Label Label15
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Label15"
      Height          =   15
      Left            =   45
      TabIndex        =   14
      Top             =   90
      Width           =   9420
   End
   Begin Label Label11
      BorderStyle     =   1  'Fixed Single
      Height          =   915
      Left            =   45
      TabIndex        =   17
      Top             =   90
      Width           =   15
   End
End

Sub AboutButton_Click ()
    Form2.Show 1
End Sub

Function CheckDLLVersions (DLLName$, expMajVer%, expMinVer%, expRev%, expBeta%) As Integer

    CrLf$ = Chr$(13) + Chr$(10)

    ccode% = GetDLLVersion(DLLName$, majorVer%, minorVer%, revLevel%, betaLevel%)
    If ((majorVer% < expMajVer%) Or ((majorVer% = expMajVer%) And (minorVer% < expMinVer%)) Or ((majorVer% = expMajVer%) And (minorVer% = expMinVer%) And (revLevel% < expRev%))) Then
        'ignore beta level
        Msg$ = "Incorrect version of " + DLLName$ + CrLf$
        Msg$ = Msg$ + "Your version is: " + Str$(majorVer%) + "." + Format$(minorVer%, "#")
        Msg$ = Msg$ + Format$(revLevel%, "#") + Format$(betaLevel%, "#") + CrLf$
        Msg$ = Msg$ + "This program requires " + Str$(expMajVer%) + "." + Format$(expMinVer%, "#") + Format$(expRev%, "#") + " or above"
        MsgBox Msg$, 16, "Critical Error"
        CheckDLLVersions = False
    Else
        CheckDLLVersions = True
    End If
End Function

Sub CloseButton_Click ()
    End
End Sub

Sub Form_Load ()
    Screen.MousePointer = 11        'change mouse cursor to hourglass

    'make sure we're using right versions of NetWare DLLs
    If (Not CheckDLLVersions("NWCore.DLL", 1, 2, 2, 0)) Then
        End
    End If

    If (Not CheckDLLVersions("NWWrkstn.DLL", 1, 2, 2, 0)) Then
        End
    End If

    If (Not CheckDLLVersions("NWServer.DLL", 1, 2, 2, 0)) Then
        End
    End If

    If (Not CheckDLLVersions("NWBind.DLL", 1, 2, 2, 0)) Then
        End
    End If

    For connID& = 1 To 8
        'for each connection in workstation's file server name table
        'get the table entry, then see if it's null

        fileServerName$ = String$(48, 0)
        GetFileServerName connID&, fileServerName$
        If Left$(fileServerName$, 1) <> Chr$(0) Then
            'you have to explicitly look for a null in the first character,
            'because Visual Basic doesn't know about null-terminated strings
            '(a null prints as a space)

            ServerNameBox.AddItem fileServerName$
        End If
    Next connID&

    ScanBindery     'scan the bindery of the default server
End Sub

Sub RescanButton_Click ()
    ServerNameBox_DblClick  'same effect as if the user had
                            'double-clicked on a file server name
End Sub

Sub ScanBindery ()
    Dim objectType As String * 6

    Screen.MousePointer = 11        'change mouse cursor to hourglass

    Do While BinderyObjList.ListCount
        'clear out the old list of bindery objects
        BinderyObjList.RemoveItem 0
    Loop

    oID& = -1   'initialize object ID to -1 for first call to ScanBinderyObject
    Do
        oName$ = String$(48, 0)
        ccode% = ScanBinderyObject("*", OT_WILD, oID&, oName$, oType%, oHasProps%, oFlag%, oSecurity%)
        If (Not ccode%) Then
            'take all characters of object name up to terminating null
            out$ = Left$(oName$, InStr(oName$, Chr$(0)) - 1)

            'then take first 20 chars
            out$ = Left$(out$, 20)

            'pad with space